perm filename DESTRU.3[AID,LSP] blob sn#420607 filedate 1979-02-22 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(defun destructure (l)
C00004 ENDMK
CāŠ—;
;(defun destructure (l)
;       (destructure1 l nil))

(defun %%destructure1%% (l path)
       (cond ((null l) nil)
	     ((atom l)(ncons (cons l path)))
	     (t (append (%%destructure1%% (car l) (cons 'car path))
			(%%destructure1%% (cdr l) (cons 'cdr path))))))  

(defun %%destructurify%% (vars vals)
 (mapcar
  (function
   (lambda (q r)
	   (cond ((atom q)
		   (list q r nil))
		 ((atom r)
		  (list nil nil (%%pathify%% (%%destructure1%% q nil) r)))
		 (t ((lambda (g)
		      (list g r (%%pathify%% (%%destructure1%% q nil) g)))  
		     (gensym))))))
  vars vals))

(defun %%pathify%% (path gen)
       (mapcar
	(function 
	 (lambda (q)
	  (list (car q) (%%code-path%% (cdr q) gen))))  
	 path))

(defun %%code-path%% (path name)
 (cond ((null path) name)
       (t (list (car path) (%%code-path%% (cdr path) name)))))